﻿Option Strict Off
Option Explicit On
Module Record_Get
    Public Structure FldData 'yields field data (content, datatype, lenght)
        Dim fdContent As Object
        Dim fdType As Byte
        Dim fdLen As Integer
        Dim fdStart As Integer
    End Structure

    'alternative fieldencoding procedure
    'kette von bytes (byte array)
    'jedes feld:
    '   nummer(1 byte)
    '   type(1 byte)
    '   [länge]: optional wenn type=string:
    '       <255:   1 byte
    '       >=255:  255(&HF) + 2byte länge
    '   data (variable in string, fixed all other types)

    'needed: pArr = StrConv(sPlain, vbFromUnicode)
    'sPlain=decrypted string without

    Public Function ExtractFields(ByRef aContent() As String, ByVal sStr As String, Optional ByVal bNotFldNr As Boolean = False) As Short
        ' bNotFldNr: for categories with max 9998 (field numbers are maximized to 255)
        Dim i, j As Integer
        Dim Carray() As Byte
        Dim fldNr, fldType As Byte
        Dim fldLen As Integer
        Dim fldContent As String = ""
        'Dim vMinutes As Object
        'Dim ynRedimContent As Boolean
        'Dim ss As String
        Dim N As Integer
        Dim pArr() As Byte
        ExtractFields = 0
        N = Len(sStr)

        If Len(sStr) = 0 Then Exit Function

        ReDim pArr(N + 1)
        Try
            For i = 0 To N - 1
                pArr(i) = Convert.ToByte(sStr(i))
            Next i
        Catch ex As Exception
            MessageBox.Show(ex.Message)
        End Try
        
        For i = 0 To UBound(aContent)
            aContent(i) = ""
        Next i
        i = 0
        Do While (i < N)
            fldNr = pArr(i)
            'If fldNr = 27 Then Stop
            fldType = pArr(i + 1)
            i = i + 2

            Select Case fldType
                Case 10, 12 'dbText, dbMemo
                    fldLen = pArr(i)
                    i = i + 1
                    Select Case fldLen
                        Case 0
                            fldContent = ""
                        Case Else
                            If fldLen = 255 Then
                                fldLen = pArr(i + 1) * 256 + pArr(i)
                                i = i + 2
                            End If
                            ReDim Carray(fldLen - 1)
                            For j = 0 To UBound(Carray)
                                Carray(j) = pArr(i + j)
                            Next j
                            fldContent = ""
                            For j = i To i + fldLen - 1
                                fldContent = fldContent & sStr(j)
                            Next
                            i = i + fldLen
                    End Select
                Case 1 'dbBoolean
                    fldContent = sStr(i)
                    i = i + 1
                Case 2 'dbByte
                    fldContent = sStr(i)
                    i = i + 1
                Case Else
                    fldContent = ""

            End Select
            aContent(fldNr - 1) = fldContent
        Loop
    End Function
End Module